
;installation-summary
;save-vista-workspace, save-current-workspace...

(defun set-filetypes ()
  (let ((wd (get-working-directory)))
    (set-working-directory *default-path*)
    (with-open-file (f (strcat *default-path* "filetypes.bat") :direction :output)
                    (format f "assoc .lsp=XLispSourceCode~%")
                    (format f "assoc .fsl=XLispByteCode~%")
                    (format f "assoc .wks=XLispWorkSpace~%")
                    (format f "assoc .vdf=ViStaDataFile~%")
                    (format f "assoc .vaf=ViStaAppletFile~%")
                    (format f "assoc .vis=ViStaSourceCode~%")
                    (format f "ftype XLispSourceCode=\"~aLispBoss\\lispboss.exe\" \"%%1\"~%"*default-path*)
                    (format f "ftype XLispByteCode=\"~avista.exe\" \"%%1\"~%"*default-path*)
                    (format f "ftype XLispWorkSpace=\"~avista.exe\" \"%%1\"~%"*default-path*)
                    (format f "ftype ViStaDataFile=\"~aLispBoss\\lispboss.exe\" \"%%1\"~%"*default-path*)
                    (format f "ftype ViStaAppletFile=\"~aLispBoss\\lispboss.exe\" \"%%1\"~%"*default-path*)
                    (format f "ftype ViStaSourceCode=\"~aLispBoss\\lispboss.exe\" \"%%1\"~%"*default-path*)
                    )
    (system (format nil "~afiletypes.bat"*default-path*))
    (set-working-directory wd))
  )

(defun show-filetypes ()
  (let ((wd (get-working-directory))
        (text (format nil "~%
FILETYPE         EXT  PROGRAM       PATH
XLispSourceCode  lsp  lispboss.exe  ~a\LispBoss
ViStaDataFile    vdf  lispboss.exe  ~a\LispBoss
ViStaAppletFile  vaf  lispboss.exe  ~a\LispBoss
ViStaSourceCode  vis  lispboss.exe  ~a\LispBoss
XLispByteCode    fsl  vista.exe     ~a
XLispWorkSpace   wks  vista.exe     ~a
" *default-path* *default-path* *default-path* *default-path* *default-path* *default-path*)))
    (help text)
    ))

(defun make-filetypes.bat () 
  (set-filetypes))

(defun cd (path) (set-working-directory path))
(defun pwd () (get-working-directory ))

(defun lisped (&optional file) 
  (if file (system (format nil "lspedit.exe ~a" file))
      (open-file-dialog)))

(defun documentation-files ()
	(set-working-directory (strcat *default-path* "doco"))
	(open-file-dialog))

(defun baktrace-functions (&optional (n 10))
"baktrace functions only - no arguments"
  (baktrace n nil))

(defun startup-show-vista ()
  (cond (*vista-startup*
         (load (strcat *default-path* "startup\\vista\\vistart.lsp"))
         t)
    (t (show-vista)
       nil)))

(defun startup-exit-on-close ()
   (when *current-spreadplot*
         (defmeth *current-spreadplot* :close () (exit))))

(defun set-vista-distributor-mode ()
"if first run and is *pro-version* (which depends on user-mode, admin-mode 
and directory structure, and is devel-mode, set all devel mode variables and set distrib mode. never change *pro-version*. *devel-mode* is changed by menu item."
  (when (and (= *run-number* 1) 
             *pro-version*
             *devel-mode*)
        (developer-mode)
        (load-distributor)
        (send *logo* :set-no-animation)
        (make-vista-copyright))
  *devel-mode*)

(setf *size-verbose* nil)

(defun report-sizes ()
	(when *size-verbose*
  (format t "*desktop-loc-size*                ~a~%" *desktop-loc-size*)
  (format t "(send *vista* :desktop-size)      ~a~%" (send *vista* :desktop-size))
  (format t "(send *vista* :spreadplot-size)   ~a~%" (send *vista* :spreadplot-size))
  (format t "(send *vista* :workmap-size)      ~a~%" (send *vista* :workmap-size))
  (format t "(send *workmap* :size)            ~a~%" (send *workmap* :size))
  (if *datasheet*
      (format t "(send *datasheet* :size)          ~a~%" (send *datasheet* :size))
      (format t "no datasheet~%"))
  (if *fake-datasheet*
      (format t "(send *fake-datasheet* :size)     ~a~%" (send *fake-datasheet* :size))
      (format t "no fake-datasheet~%"))
  (format t "(send *vista* :datasheet-sizes)   ~a~%~%" (send *vista* :datasheet-sizes))
  ))

(defun refresh-system ()
  (send *workmap* :draw-mode 'normal)
  (send *workmap* :line-type 'solid)
  (send *workmap* :redraw)
  (format t "~%[ draw modes reset ]~%")
  (restore-desktop)
    (format t "[ desktop restored ]~%")
  (stop-all-plots)
  (format t "[ system refreshed ]~%")
  (force-output)
  (top-level))

(defun all-plots ()
  (remove nil 
          (mapcar #'(lambda (x) 
                      (let ((object (nth 2 x)))
                        (if (kind-of-p object graph-window-proto) 
                            object
                            nil)))
                  *hardware-objects*)))

(defun how-many-stopped () (stop-all-plots))

(defun stop-all-plots (&optional quiet)
    (let* ((re (stop-all-plots2))
           (n (length re))
           (m (length (mapcar #'(lambda (i) (member i re))
                              (which re)))))
	(when (not quiet)
      (if (= m 0) 
          (format t "[ ~d windows open; 0 running ]~%" n)
          (format t "[ ~d windows open; ~d running; all stopped ]~%" m n )))))

(defun stop-all-plots2 ()
"Args: ()
Stops idle activity for all plot windows."
  (let ((plots (remove nil 
                       (mapcar #'(lambda (x) 
                                 (let ((object (nth 2 x)))
                                   (if (kind-of-p object graph-window-proto) 
                                       object
                                       nil)))
                               *hardware-objects*))))
    (mapcar #'(lambda (x) (if (send x :idle-on) 
                              (progn (unless (kind-of-p x LOGO-PROTO2)
                                             (send x :idle-on nil))
                                    t)
                              nil))
            plots)))

    
(defun check-all-plots ()
"Args: ()
Checks status of all plot windows."
  (let ((plots (remove nil 
                       (mapcar #'(lambda (x) 
                                 (let ((object (nth 2 x)))
                                   (if (kind-of-p object graph-window-proto) 
                                       object
                                       nil)))
                               *hardware-objects*))))
    (mapcar #'(lambda (x) 
                (let ((popable (send x :pop-out t))
                      (removable)
                      )
                  (unless popable (send x :front-window))
                  (unless (two-button-dialog (format nil "~a~%~a" (send x :title) 
                                                     (send x :slot-value 'proto-name))
                                             :first-button "OK" :second-button "Remove")
                          (unless (two-button-dialog "Are You Sure?" :first-button "Oops!"
                                                     :second-button "I'm Sure!!!")
                                  (setf removable t)))
                  (when popable (send x :pop-out nil))
                  (when removable (send x :remove))
                  (when (send x :idle-on) 
                        (when (two-button-dialog "Turn Idling Off?"
                                                 :first-button "Yes, Please Do!" 
                                                 :second-button "No, Leave It On")
                              (send x :idle-on nil)))
                  nil))
            plots)))



(defmeth container-proto :desktop-redraw (nilt)
  (cond
    (nilt
     (send *workmap* :back-color 'workmap-background)
     (send *var-window* :back-color 'workmap-background)
     (send *obs-window* :back-color 'workmap-background)
     (defmeth (send *varobs-obj* :fake-overlay) :redraw ()(call-next-method))
     (defmeth *workmap* :redraw ()(call-next-method))
     (defmeth *desktop-datasheet* :redraw ()(call-next-method))
     (defmeth *varobs-obj* :redraw ()(call-next-method))
     )
    (t
     (send *workmap* :back-color 'white)
     (send *var-window* :back-color 'white)
     (send *obs-window* :back-color 'white)
     (defmeth (send *varobs-obj* :fake-overlay) :redraw ())
     (defmeth *workmap* :redraw ())
     (defmeth *desktop-datasheet* :redraw ())
     (defmeth *varobs-obj* :redraw ())
     )))

(defun wait-for-file-to-update (file-name verbose)
  (let* ((original-file-date (file-write-date file-name))
         (new-file-date)
         (current-new-file-length)
         (previous-new-file-length 0)
         )
    (setf i 0)
    (loop
     (setf new-file-date (file-write-date file-name))
     (cond 
       ((= original-file-date new-file-date)
        (pause 60)
        (setf i (1+ i))
        (when verbose
              (Please-wait (format nil "Please Wait For File Update (~d)" i))))
       (t
        (with-open-file (f "xlisp.wks")               
                        (loop 
                         (pause 60)
                         (setf i (1+ i))
                         (when verbose
                               (Please-wait (format nil 
                                       "Please Wait For File Write  (~d)" i)))
                         (setf current-new-file-length (file-length f))
                         (format t "~d ~d ~d ~%" i 
                                 new-file-date 
                                 current-new-file-length)
                         (cond 
                           ((= current-new-file-length 
                               previous-new-file-length)
                            (return))
                           ((setf previous-new-file-length current-new-file-length)
                            )))
                        (return)))))))




(defun installation-summary (&optional (one-button t))
  (let* ((header (send text-item-proto :new (format nil "SUMMARY OF CURRENT INSTALLATION STATUS~2%EACH UPPERCASE WORD IS A VARIABLE WHOSE VALUE IS SET DURING INSTALLATION.")))
         (summary (send text-item-proto :new 
                        (format nil "This is a ~a Installation.~2%1 ViSta is being installed on this ~a~%    (can be \"COMPUTER\" or \"NETWORK\").~2%2 ViSta will be used by ~a~%    (can be \"ONE\" or \"SEVERAL\").~2%3 The User~a can save results in: ~%    ~a~2%4 The Data Library Path is: ~%    ~a~2%5 Changes made by the User to ViSta ~a~%    persist across sessions.~2%6 ViSta ~a available from within Excel.~2%7 ViSta's wxls32.ini file will be located in~%     ~a~a" 
           (if *installation-type* *installation-type* "Developer's")
           (if *computing-environment* *computing-environment* "Development Computer")
           (if (equal *user-type* "User") "ONE user" "SEVERAL users")
           (if (equal *user-type* "User") " " "s ")
           (string-upcase *user-dir-name*)
           (string-upcase *data-path*)
           (if *update-pref-files* "DO" "DO NOT ")
           (if *change-excess* "IS" "IS NOT")
           (string-upcase *ini-file*)
           (if *pro-version*
               (format nil "~2%7 You DO HAVE developer rights.")
               (format nil " "))
           
           )))

         (header2 (send text-item-proto :new (format nil "User privilages include~%(you can customize these here):")))
         (devel (list "The Developer's Menu (needed)" 
                      "Changing Menus (caution)" 
                      "Changing Fonts (caution)" 
                      "Changing Directories (caution)"))
         (user  (list "Changing the Startup Options" 
                      "Changing the Toolbar's Buttons"
                      "Changing the WorkMap's Appearance" 
                      "Changing Excel's ViSta Menu"
                      ))
         (users (list "Changing the Toolbar's Buttons"
                      "Changing the WorkMap's Appearance" ))
         (strings (cond
                    (*pro-version* (combine devel user))
                    ((equal *user-type* "User") user)
                    ((equal *user-type* "NetUser") users)))
         (devel-settings 
          (list *show-devel-menu* *configure* *change-fonts* *change-directories*))
         (user-settings
          (list *update-pref-files* *change-profiles* *change-toolbar* 
                *change-workmap* *change-excess* ))
         (users-settings
          (list  *change-toolbar* *change-workmap*))
         (devel-symbols 
          (list '*show-devel-menu* '*configure* '*change-fonts* '*change-directories*))
         (user-symbols
          (list '*update-pref-files* '*change-profiles* '*change-toolbar* 
                '*change-workmap* '*change-excess* ))
         (users-symbols
          (list  '*change-toolbar* '*change-workmap*))
         (settings (cond
                     (*pro-version*  (combine devel-settings user-settings))
                     ((equal *user-type* "User") user-settings)
                     ((equal *user-type* "NetUser") users-settings)))
         (symbols (cond
                     (*pro-version*  (combine devel-symbols user-symbols))
                     ((equal *user-type* "User") user-symbols)
                     ((equal *user-type* "NetUser") users-symbols)))
         (choices (mapcar #'(lambda (string setting)
                              (send toggle-item-proto :new string :value setting))
                          strings settings))
         (space  (send text-item-proto :new " "))
         (accept (send modal-button-proto :new "Accept" 
                     :action #'(lambda ()
                                 (mapcar #'(lambda (choice) 
                                             (send choice :value))
                                         choices))))
         (revise (send modal-button-proto :new "Revise"
                     :action #'(lambda () "Revise")))
         (help (send button-item-proto :new "Help" 
                     :action #'(lambda () (get-config-help))))
         (ok (send modal-button-proto :new "OK"))
         (dialog (send modal-dialog-proto :new 
                       (list header
                             (list (list summary)
                                   (list header2 (list space choices)))
                             (if one-button
                                 ok
                                 (list accept revise help)))
                       :title "ViSta Installation Summary Dialog"
                       :default-button ok))
         (results (send dialog :modal-dialog))
         )
    (unless (equal results "Revise")
            (mapcar #'(lambda (variable value)
                        (set variable value))
                    symbols results))
    ;(first (select (send self :nexts) in-step))
    ))


(defun rename-wks ()
  (setf renamed-wks (rename-vista-file "xlisp.wks" "xlisp.bak")))


(defun strcat (&rest args) 
  (apply #'concatenate 'string args))

(defun copyright ()
    (format t "~%~a" *vista-copyright*))


  (defun now-what? () (new-now-what))
  

  (defun new-now-what ()
    (format t "; constructing configuration options dialog~%")
   
    (let* ((t0 (send text-item-proto :new 
                     (format nil 
                             "~A WORKSPACE PREPARED~%"
                             (if *make-distribution* "DISTRIBUTOR'S"
                                 "DEVELOPER'S"))))
           (t1 (send text-item-proto :new (project-stats-info)))
           (t2 (send text-item-proto :new "NEXT RUN START IN:      "))
           (c2 (send choice-item-proto :new 
                     (list "DEVELOPER Mode"  
                           "USER Mode")))
           (t3 (send text-item-proto :new "REVIEW CURRENT:"))
           (c3 (send toggle-item-proto :new "Configuration"
                     :action #'installation-summary))
           (c5 (send toggle-item-proto :new "Paths"
                     :action #'display-ini-paths))
           (c4 (send toggle-item-proto :new "Automatic ReStart?" :initial t))
           
           (ok (send modal-button-proto :new     "SAVE WORKSPACE!"
                     :action #'(lambda () (list 0 (send c2 :value) 
                                                (send c3 :value) (send c4 :value)))))
           (cancel (send modal-button-proto :new "DO NOT SAVE IT!"
                         :action #'(lambda () (setf *statinit-verbose* t)
                                     (setf *vista-start-case* 12)
                                     (top-level)
                                     (top-level))
                         ))
           (please (when *please-wait* (send *please-wait* :remove)))
           (dialog (send modal-dialog-proto :new
                         (list t0 t1 (list (list ok cancel) (list t2 c2) ))
                         :title "SAVE WORKSPACE"))
           (result (send dialog :modal-dialog))
           (action) 
           (install-summary)
           (restart?))
      (when (not result) (exit))
      (setf action (first result))
      (setf restart? (fourth result))
      (case (second result)
        (1 (setf *force-user-mode* t) 
           (user-mode)))
      (setf install-summary (third result))
      (case action
        (0 ;current
           (setf *vista-start-case* 2))
        (1 ;default
           (setup-install-vista)
           (update-installation-info)
           (setf *initial-install* nil)
           (setf *visible-startup* nil)
           (setf *show-flying-logo* t)
           (setf *show-zooming-desktop* t)
           (setf *show-flying-exit-logo* t)
           (setf *vista-start-case* 2);3
           )
        (2 ;dialogs
           (setf *statinit-maker-error-flag* nil)
           (setf *vista-start-case* 3)
           ))
      (send dialog :size (- (first (send dialog :size)) 100) (second (send dialog :size)))
      (msw-write-profile-string "XLisp" "HideMainFrame" "yes" "wxls32.ini")
      (write-prefload-file nil *prefs-path*)
      (print-closing-workspace-id-info "Developer's" "Unlocalized")
      (case action
            (0 (save-current-workspace "xlisp.wks" restart? install-summary))
            (1 (save-default-workspace "xlisp.wks" restart? install-summary))
            (2 (save-custom-workspace  "vista-customizer.wks" restart? install-summary)))
      ))


(defun save-current-workspace (name &optional restart? install-summary user-wks?)
 ; (one-button-dialog (format nil "~%; CREATING ~a CURRENT~aLOCALIZED WORKSPACE.~2%"
 ;         (if user-wks? "USER'S" "DEVELOPER'S") 
 ;         (if user-wks? " " " UN")))
  ;(listeners)(verbose t)
  (setf *installation-type* "CURRENT")
  (setf *computing-environment* "COMPUTER")
  (setup-install-vista t)
  (setf *vista-start-case* 9)
  (update-installation-info nil nil)
 ; (when restart? (setf *vista-start-case* 12)(top-level) )
 ; (system "vista.exe init.lsp")
  ;(setf *force-user-mode* nil)
  (save-vista-workspace name (if user-wks? "User's" "Developer's") 
                        restart? install-summary))

(defun save-default-workspace (name restart? install-summary)
  (format t "~%; CREATING DEFAULT LOCALIZED WORKSPACE.~2%")
  (setup-install-vista);turns off verbose
  (setf *verbose* t) 
  (setf *installation-type* "DEFAULT")
  (setf *computing-environment* "COMPUTER")
  (set-vista-pro-version) 
  (set-default-install)
  (update-installation-info)
  (define-vista-paths)
  (setf *vista-start-case* 9);1
  (setf *run-number* -10)
  (setf *initial-install* t)
  (save-vista-workspace name "Default" restart? install-summary))

(defun save-custom-workspace (name restart? install-summary)
  (defun dispose () (save-vista-workspace "Custom"))
  (format t "~%; CREATING CUSTOM UNLOCALIZED WORKSPACE.~2%")
  (setf *installation-type* "CUSTOM")
  (setf *computing-environment* "COMPUTER")
  (setf *vista-start-case* 3) ;3?
  (setf *initial-install* t)
  (setf *run-number* -10)
  (setup-install-vista t)
  (setf *verbose* t) 
  (save-all-prefs)
  (install-vista)
  ;(do-vista-installation-hyperlog)
  ;(save-vista-workspace name "Custom" install-summary)
  )

(defun save-vista-workspace (name wks-string restart? &optional install-summary)
"Arg: name wks-string
Saves vista workspace NAME (default XLISP.WKS) in current directory. WKS-STRING is used to title printout when creating the workspace (current, default or custom)"
  (setf *verbose* t)
  (when *verbose* (format t "~%; preparing to save vista workspace~%"))
  (print-closing-workspace-id-info wks-string "unlocalized")
  (when *force-user-mode* (user-mode))  
  (setf *make-time* nil);indicates nolonger in make-mode
  (setf *statinit-maker-error-flag* nil)
  (when install-summary (installation-summary t))
  (format T "~2%; SAVING UNLOCALIZED ~a WORKSPACE AS FILE ~a~%" 
          (string-upcase wks-string) (string-upcase  name))
  ;(PAUSE 120)
  (VISTA-COPYRIGHT)
  (format t "~%")
  (make-version)
  (version)
  (when *listener* 
        (send *listener* :close)
        (setf *listener* nil))
 (hidemainwindow)
  ;(one-button-dialog "Click When Ready" )
  ;(showmainwindow 100 100 330 130)
  ;(pause 60)
  (verbose nil)
  (setf *visible-startup* nil)
  (when *make-distribution*
        (setf *devel-version* nil)
        (setf *make-distribution* nil))
  (save-all-prefs)
  (double-dribble nil)

  (let* ((curdir (get-working-directory))
         (libdir (msw-get-profile-string "ViSta" "LibDir" 
                                         (strcat curdir "wxls32.ini")))
         (ini (strcat libdir "\\wxls32.ini"))
         )
    (cond 
      (restart?
       (msw-write-profile-string "ViSta" "Starter" "ViSta" ini)
       (msw-write-profile-string "ViSta" "StartUp" "ReStart" ini)
       (system "vista.exe"))
      (t 
       (msw-write-profile-string "ViSta" "Starter" "None" ini)
       (msw-write-profile-string "ViSta" "StartUp" "None" ini)))
    (save-workspace name)
    (exit)
    ))
 
;  (exit)

(defun print-closing-workspace-id-info (type local? &optional (name "xlisp.wks"))
  (format t "~%; SUMMARY INFO FOR ~a ~a WORKSPACE~2%; WorkSpace File: ~a~%"
            (string-upcase local?) (string-upcase type)
          (strcat (get-working-directory) "\\" name))
  (when *make-log* (format t "; WorkSpace Log:  ~a\\~a~%" 
          (get-working-directory) (format nil "wks~a.log" *log-number*)))
  (format t "; WorkSpace ID:   ~a~%; WorkSpace Date: ~a~%" 
          *vista-id-number* *build-date*)
  )



(defun vista-release-numbers ()
"Args: none
The string *release-number* has a value which is a four-part string formatted major.minor.subminor.build. Takes the value of *release-number* and binds *vista-major-release-string*, *vista-minor-release-string*, *vista-subminor-release-string* to the first three portions of the string, and binds *vista-major-release*, *vista-minor-release*, and *vista-subminor-release* to numeric values read from the appropriate portion of the string. Returns a list of the four numeric values: *vista-major-release*, *vista-minor-release*, *vista-subminor-release* and *build-number*."
(let* ((temp-str *release-number*)
       (locdot1 (position #\. temp-str)) (locdot2) (locdot3))
  (setf *vista-major-release-string* (select temp-str (iseq 0 (1- locdot1))))
  (setf *vista-major-release* 
        (read-from-string (select temp-str (iseq 0 (1- locdot1)))))
  (setf temp-str 
        (select temp-str (iseq (1+ locdot1) (1- (length temp-str)))))
  (setf locdot2 (position #\. temp-str))
  (cond
    (locdot2
     (setf *vista-minor-release-string* (select temp-str (iseq 0 (1- locdot2))))
     (setf *vista-minor-release*
           (read-from-string (select temp-str (iseq 0 (1- locdot2)))))
     (setf temp-str (select temp-str (iseq (1+ locdot2) (1- (length temp-str)))))
     (setf locdot3 (position #\. temp-str))
     (when locdot3 (setf temp-str (select temp-str (iseq locdot3))))
     (setf *vista-subminor-release-string* temp-str)
     (setf *vista-subminor-release* (read-from-string temp-str))
     
     )
    (t 
     (setf *vista-minor-release-string* temp-str)
     (setf *vista-minor-release* (read-from-string temp-str))
     (setf *vista-subminor-release-string* nil)
     (setf *vista-subminor-release* nil)))
  (list *vista-major-release*
        *vista-minor-release*
        *vista-subminor-release*
        *build-number*)))


(defun show-pretty-copyrights (&key location size)
    (let* ((pc-window (pretty-copyright-window :size size :location location)))
      (display-string (format nil "~2%~a~2%Click Window to Close." (date)) pc-window)
       (defmeth pc-window :do-click (&rest args) (send self :close))
      pc-window))

(defun pretty-copyrights (&optional window all viva)
    (let* ((cp (copyrights)))
      (when all
            (display-string 
              (format nil "~5%~a~%           ~a~%           ~a~%" 
                    (select cp 0) (select cp 1) (select cp 2)) window)
            (display-string
              (format nil "~a~%           ~a~%" 
                    (select cp 4) (select cp 5)) window)
            (display-string
              (format nil "WIN-XLSTAT XLispStat customized for Windows Release 3.52.13.1 (Beta).~%           ~a~%" 
                    (select cp 8)) window))
      (when viva (write-viva-listener-header))
      (display-string
         (format nil "~%~a~%        ~a. All rights reserved.~%        ~a~%" 
              "ViSta:  The Visual Statistics System" (select cp 11) (select cp 12)) window)
      ))

(defun all-copyrights-string ()
  (Let* ((cp (copyrights))
         (str (strcat
               (format nil  "~%~a~%           ~a.~%           ~a~%" 
                       "ViSta:     The Visual Statistics System" 
                       (select cp 11) (select cp 12))
               
               (format nil "~%LispStat   A Lisp Environment for Developing~%           Dynamic Statistical Graphics Systems~%           ~a~%           Release 3.52.13 (Beta)~%" 
                       (select cp 5))

               (format nil  "~%LispStat-W LispStat Enhancements for Windows~%           ~a~%           Release 3.52.13.1 (Beta)~%"
                       (select cp 8))

               (format nil "~%XLisp-Plus A Portable, Freely Redistributable Lisp System~%           ~a~%           ~a~%           ~a~%" 
                       (select cp 1) (select cp 2)(select cp 0) )
               (format nil  "~%Parcil     Parse C into Lisp~%           Copyright (c) 1992 by Erann Gat.~%           Used under terms of GNU General Public License.~%           Free Software Foundation. All rights reserved.~%")
               (format nil  "~%ViVa       ViSta's Interactive Vectorized Algebra System~%           Copyright (c) 1999-~a by Forrest W. Young.~%~%" (select (get-decoded-time-list) 5) ))))
    str))
               

(defun show-pretty-copyrights (&key location (size '(435 375)))
    (let* ((pc-window (pretty-copyright-window :size size :location location)))
      ;(display-string (format nil "Click Window to Close.~2%" ) pc-window)
       (send pc-window :title "Click me to Close me.")
       (defmeth pc-window :do-click (&rest args) (send self :close))
      pc-window))


(defun pretty-copyright-window (&key location (size '(435 375)))
  (unless size (setf size (send *desktop-container* :size)))
  (unless location 
          (setf location (+ (floor (/ (- (send *desktop-container* :size) size) 2))
                            '(30 40))))
  (Let* ((window (report-header "Copyrights"
                                :show t :local-menus nil
                                :location location :size size
                                :page nil :pop-out t :free t
                                :container nil))
         (str (all-copyrights-string)))
    (display-string str window)
    (apply #'send window :location location)
    (apply #'send window :size size)
    (send window :pop-out t)
    (send (send window :menu) :remove)
    window))

               
(defun all-copyrights (&key location size)
  (unless size (setf size (send *desktop-container* :size)))
  (unless location 
          (setf location (+ (floor (/ (- (send *desktop-container* :size) size) 2))
                            '(0 4))))
  
  (let ((window 
         (send *desktop-container* :container-message (all-copyrights-string)
              ; :in *desktop-container* :pop-out nil 
               :fit t :menu nil :local-menus nil
               :width 484 :lines 21 )))
    ;(send window :pop-out nil)
    ;(send window :size size)
    ;(send window :location location)
    window))

                         